home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / prolog / sbprolog / amiga / cmplibsr.zoo / $getclauses.P < prev    next >
Text File  |  1988-09-15  |  4KB  |  104 lines
  1. /************************************************************************
  2. *                                    *
  3. * The SB-Prolog System                            *
  4. * Copyright SUNY at Stony Brook, 1986; University of Arizona,1987    *
  5. *                                    *
  6. ************************************************************************/
  7.  
  8. /* --------------------------- $getclauses.P --------------------------- */
  9.  
  10. $getclauses_export([$getclauses/2,$getclauses/3,$attach/2,$expand_term/2]).
  11.  
  12. $getclauses_use($bio,[_,_,_,_,_,_,_,_,_,_,$see/1,$seeing/1,$seen/0]).
  13. $getclauses_use($listutil1,[$reverse/2,$merge/3,$absmember/2,$absmerge/3,
  14.         $nthmember/3,$nthmember1/3,$member2/2,$closetail/1]).
  15. $getclauses_use($blist,[$append/3,$member/2,$member1/2]).
  16. $getclauses_use($meta,[$functor/3,_,_]).
  17. $getclauses_use($read,[$read/1,$read/2]).
  18.  
  19. $getclauses(Filename,ClauseList) :- $getclauses(Filename,ClauseList,_).
  20.  
  21. $getclauses(Filename, ClauseList,PredList) :-
  22.     $seeing(InStr),
  23.     $see(Filename),
  24.     $getclauses1(ClauseList0,[],PredList),
  25.     $seen,
  26.     $see(InStr),
  27.     $getcl_collect(ClauseList0, ClauseList),
  28.     $getcl_closetails(ClauseList).
  29.  
  30. $getclauses1(ClauseList,ClauseListTail,PredList) :-
  31.     $read(T),
  32.     $expand_term(T,Cl),
  33.     (Cl = end_of_file ->
  34.         (ClauseListTail = ClauseList,
  35.          $closetail(PredList),
  36.      !
  37.         ) ;
  38.     (Cl = ':-'(Command) ->
  39.         (call(Command),
  40.          $getclauses1(ClauseList,ClauseListTail,PredList)
  41.         ) ;
  42.              (ClauseList = [Cl | ClauseListRest],
  43.               $getcl_pred(Cl,P,N),
  44.           $member1( (P/N), PredList),
  45.                 $getclauses1(ClauseListRest,ClauseListTail,PredList)
  46.         )
  47.     )
  48.     ).
  49.  
  50. /*  "$getcl_collect" is used to gather together the clauses for individual
  51.      predicates.  Each entry for a predicate is of the form
  52.  
  53.        pred(Pred,Arity,CpyFlag,CutFlag,ClauseList).
  54.  
  55.      Once all the clauses have been read, the list of such 5-tuples
  56.      that has been constructed will be traversed to set the values
  57.      of "CpyFlag" and "CutFlag", which are as follows: if "CpyFlag"
  58.      is 1 then the predicate contains constructs like cut, negation or
  59.      if-then-else that require copying, while if it is 0 then it does
  60.      not; "CutFlag" indicates whether or not the predicate contains cuts.
  61.      This is useful because whenever cuts or negations are present, the
  62.      program must be transformed to handle them, and this involves the
  63.      creation of structures on the heap.
  64.      
  65.      Each clause is represented as terms of the form
  66.      
  67.          fact(Fact,CpyFlagRest) or rule(Head,Body,CpyFlag,CpyFlagRest)
  68.     
  69.     where CpyFlag is 1 or 0 depending on whether the rule contains
  70.     constructs like cut, negation or if-then-else, and CpyFlagRest gives
  71.     the same information for the remaining clauses.              */
  72.  
  73. $getcl_collect([],L) :- $closetail(L), !.
  74. $getcl_collect([(H :- B)|PRest],L) :- !,
  75.     $functor(H,Pred,Arity),
  76.     $member1(pred(Pred,Arity,_,_,Clauses),L),
  77.     $attach(rule(H,B,_,_),Clauses),
  78.     $getcl_collect(PRest,L).
  79. $getcl_collect([(Fact)|PRest],L) :-
  80.     $functor(Fact,Pred,Arity),
  81.     $member1(pred(Pred,Arity,_,_,Clauses),L),
  82.     $attach(fact(Fact,_),Clauses),
  83.     $getcl_collect(PRest,L).
  84.  
  85. $attach(X,Y) :- (var(Y), Y = [X|_]) ;
  86.            (nonvar(Y), Y = [_|T], $attach(X,T)).
  87.  
  88.  
  89. $getcl_pred((H :- B),P,N) :- !, $functor(H,P,N).
  90. $getcl_pred(Fact,P,N) :- $functor(Fact,P,N).
  91.  
  92. $getcl_closetails([]).
  93. $getcl_closetails([Pred|PRest]) :-
  94.     $getcl_closetails1(Pred), !, $getcl_closetails(PRest).
  95.  
  96. $getcl_closetails1(pred(P,N,_,_,Clauses)) :- $closetail(Clauses).
  97.  
  98. $expand_term(T1,T2) :- term_expansion(T1, T2), !.
  99. $expand_term(T1,T2) :- functor(T1,'-->',2), !, $dcg(T1,T2).
  100. $expand_term(T,T).
  101.  
  102. /* --------------------------- $getclauses.P --------------------------- */
  103.  
  104.